New Star Software Collection

home *** CD-ROM | disk | FTP | other *** search

/ New Star Software Collection / NSS_Collection.iso / 3-170 dbase 10 for windows / 1.ima / SAMPLES.PAK / SAMPPROC.PRG < prev next >

Wrap

Text File | 1993-07-26 | 38.4 KB | 1,187 lines

******************************************************************************* * PROGRAM: Sampproc.prg * * WRITTEN BY: Borland Late Night Crew * * DATE: 7/22/93 * * UPDATED: * * VERSION: Alpha α * * DESCRIPTION: This is the procedure file called by all Bladerunner samples. * * PARAMETERS: None * * CALLS: * * USAGE: SET PROCEDURE TO Sampproc * * ******************************************************************************* ********************************** Classes ************************************ *** Class for Focus2.prg ******************************************************************************* class MyWindow of Window() * Called by Focus2.prg ******************************************************************************* this.top = 100 && window pixel row this.width = 300 && window pixel width this.clickcount = 0 && variable indicating number of times the mouse && was clicked in this window. Incremented in the && OnLeftMouseDown event handler function this.button = new Pushbutton(this) && pushbutton of this, the window this.button.width = 100 && width of pushbutton this.button.caption = "Pushbutton" this.button.left = 85 this.button.height = 40 ******************************************************************************* function OnGotFocus * Sets this window's caption when this window has focus. ******************************************************************************* this.caption = "I have focus" return .t. ******************************************************************************* function OnLostFocus * Changes the title of this window when another window obtains focus. ******************************************************************************* this.caption = "I have focus NOT" return .t. ******************************************************************************* function OnLeftMouseDown * When the mouse is clicked inside this window, increments the count of * clicks in the window, which basically amounts to the number of times * the window has been in focus since the program was started. ******************************************************************************* parameters x,y,flags this.clickcount = this.clickcount+1 this.button.caption = ltrim(str(this.clickcount)) return .t. endclass *** Classes for Puzzle.prg ******************************************************************************* class MenuWindow of Window * * Called by Puzzle.prg ******************************************************************************* private Puzzle,Draw this.height = 150 this.width = 240 this.caption = "Create New Windows" Puzzle = new PushButton(this) Puzzle.Caption = "New Puzzle Window" Puzzle.enabled = .t. Puzzle.OnLeftMouseDown = MakePuzzle && Create puzzle when left mouse && button is pressed Puzzle.top = 5 Puzzle.Left = 5 Puzzle.Width = 200 Draw = new PushButton(this) Draw.Caption = "New Draw Window" && Create the Ray painter when left && mouse button is pressed Draw.enabled = .t. Draw.OnLeftMouseDown = MakeDraw Draw.top = 30 Draw.Left = 5 Draw.Width = 200 Paint = new PushButton(this) Paint.Caption = "New Paint Window" Paint.enabled = .t. Paint.OnLeftMouseDown = MakePaint && Create the Line painter when left && mouse button is pressed Paint.top = 55 Paint.Left = 5 Paint.Width = 200 endclass ******************************************************************************* class DrawWindow of window * Defines the ray painting window. * * Called by Puzzle.prg ******************************************************************************* this.visible = .f. this.caption = "Press Mouse And Move" && when you press the mouse, move && it, and let go, a series of rays && will appear with the origin at && the point where you pressed down && the mouse *-- set the initial size of the window this.height = 400 this.width = 400 this.visible = .t. this.xpos = 0 this.ypos = 0 this.hDc = 0 this.pen = 0 * Color pushbuttons this.red = new PushButton(this) this.red.Caption = "RED" this.red.enabled = .t. this.red.OnLeftMouseDown = PushedButton && OnLeftMouseDown event handler this.red.top = this.height - 80 this.red.Left = 5 this.red.Width = 50 this.red.colorval = 255 this.red.owner = this && parent window this.blue = new PushButton(this) this.blue.Caption = "BLUE" this.blue.enabled = .t. this.blue.OnLeftMouseDown = PushedButton this.blue.top = this.height - 80 this.blue.Left = 60 this.blue.Width = 50 this.blue.colorval = 255 this.blue.owner = this this.green = new PushButton(this) this.green.Caption = "GREEN" this.green.enabled = .t. this.green.OnLeftMouseDown = PushedButton this.green.top = this.height - 80 this.green.Left = 115 this.green.Width = 50 this.green.colorval = 255 this.green.owner = this ************************************************* function Init * Initializes the window ************************************************* junk = this.OnSize(0,0,0) junk = this.SetButtonColor() return .f. ************************************************* function OnLeftMouseDown * When the left mouse button is pressed, move to * that point ************************************************* parameters x, y, flags this.xpos = x this.ypos = y *this.capture = .t. this.hDc = GetDC( this.hWnd ) this.pen = CreatePen(0,1,this.color) junk = SelectObject( this.hDc, this.pen ) junk = MoveTo(this.hDc, this.xpos, this.ypos) return .t. ************************************************* function OnLeftMouseUp * When the button is released, release the current * pen used ************************************************* parameters x, y, flags private i *this.capture = .f. i = ReleaseDC(this.hWnd, this.hDc) this.hDc = 0 i = DeleteObject(this.pen) this.pen = 0 return .t. ************************************************* function OnMouseMove * When the mouse is being moved, draw a line from * the point where the mouse button was pressed to * each point the mouse moves to. This creates rays. ************************************************* parameters x, y, flags private junk if this.hDc <> 0 junk = MoveTo(this.hDc, this.xpos, this.ypos) junk = LineTo(this.hDc, x, y ) endif return .t. ************************************************* function OnSize ************************************************* parameters top, left, width this.red.top = this.height - 80 this.green.top = this.height - 80 this.blue.top = this.height - 80 return .f. ************************************************* function SetButtonColor * Sets the color of the current rays. ************************************************* private dc,brush, r this.color = RGB(this.red.colorval, this.green.colorval, this.blue.colorval) dc = GetDC(this.hwnd) brush = CreateSolidBrush(this.color) r = Rect(this.green.left+this.green.width+5,this.height-80, 50, 50) * Fill a small rectangle with the current color junk = FillRect(dc,r,brush) junk = ReleaseDC(this.hwnd,dc) junk = DeleteObject(brush) return .f. endclass ******************************************************************************* class PaintWindow of DrawWindow * Defines the Line painter window * * Called by Puzzle.prg ******************************************************************************* this.caption = "Draw Lines" ************************************************* function OnMouseMove * When the mouse is moved, draw a line from the * last position using the current color. This * creates a continuous line as you move the mouse. ************************************************* parameters x, y, flags private junk if this.hDc <> 0 junk = LineTo(this.hDc, x, y ) endif return .f. endclass ******************************************************************************* class Puzzle of window * Creates a window with a 15 button puzzle * * Called by Puzzle.prg ******************************************************************************* private i, parent, junk this.visible = .f. this.caption = "Puzzle" *-- set the initial size of the window this.height = 400 this.width = 400 *-- set the current position of the hole this.holex = 4 this.holey = 4 parent = this *-- create 15 buttons inside the window. for i = 1 to 4 for j = 1 to 4 if(i*j <> 16) globx = i globy = j b = new ButtonTile() endif next next ************************************************* function Show ************************************************* private i i = this.OnSize(0,0,0) this.visible = .t. return .t. ************************************************* function OnSize * If the puzzle window is resized, resize the * buttons too. ************************************************* parameters top, left, width private h,w,b,i *-- BUG: account for menu width and scroll bars this.h=this.height-100 this.w=this.width-50 h = this.h/4 w = this.w/4 * redefine dimensions for the 15 buttons. for i = 1 to 15 b = this[i] b.visible = .f. && invisible so don't see flashing b.top = (b.y-1)*h b.left = (b.x-1)*w b.width = w b.height = h b.enabled = .t. next * make them all visible for i = 1 to 15 this[i].visible = .t. next return .f. ************************************************* function MoveButton * When a button is moved, assign it a new location, * and put a hole in its previous location. ************************************************* parameter b private x,y, i, j, number,o if abs(this.holex-b.x) + abs(this.holey-b.y) = 1 b.visible =.f. x = this.holex this.holex = b.x b.x = x y = this.holey this.holey = b.y b.y = y b.top = this.h/4 * (b.y-1) b.left = this.w/4 * (b.x-1) b.visible = .t. i = this.CheckWinner() && check if all buttons in place endif return .f. ************************************************* function CheckWinner * If all the buttons are in place, change the * caption of the window to "Winner". ************************************************* private i *-- check the position of each button for the correct position for i = 1 to 15 if this[i].index <> (this[i].x-1)*4+this[i].y-1 return .f. endif next *-- Set the caption of all the buttons to winner for i = 1 to 15 this[i].caption = "Winner" next return .t. endclass *** Classes for Event.prg *-- BUG: should be able to pass parameter to subobject's constructor. There * is an implied parameter 'parent' to button Tile that currently has to * be passed as a global. * *class ButtonTile(parent, globx, globy) of Button(parent) ******************************************************************************* class ButtonTile of PushButton(parent) * Creates a puzzle button. * * Called by Event.prg ******************************************************************************* this.index = (globx-1)*4+globy-1 this.caption = str(this.index+1,2) this.puzzle = parent && should be unnecessary this.x = globx this.y = globy ************************************************* Function OnLeftMouseDown * When the mouse is pressed, check if the button * can be moved, and move it, if appropriate. ************************************************* parameters x, y, flags *--BUG: code should read 'parent.MoveButton(this)' * b = this x = this.puzzle.MoveButton(b) return .f. endclass *** Procedures and Functions Called by Contact.prg *** ****************************************************************************** procedure Selectcomp * On selection routine for the Comp304 window. Brings up a regression * graph if "pushgraph" was selected, a window with a browse object * if "pushsummar" was selected, and otherwise closes the window. * * Called by Contact.prg ****************************************************************************** private active active = activecontrol() && what control was active when selection was made? do case case active = "PUSHGRAPH" select summary set filter to compcode = company->compcode *** BUG in GRAPH FORM -- while/for clauses cause GPF graph form activity &&while compcode=company->compcode set filter to select company case active = "PUSHSUMMAR" isBrowseUp = .t. define window BrowseWind from 10,10 to 25,70 ; of application; title "BROWSE" define browse companyBrowse of BrowseWind from 0,0 to 16,62 open window BrowseWind set focus to BrowseWind otherwise * Cleanup() ***BUG -- problems closing the window after closing databases * close window Comp304 endcase return ****************************************************************************** function CloseBrowse * OnClose function for BrowseWindow ****************************************************************************** isBrowseUp = .f. return .t. ****************************************************************************** function Contact_Clean * Close all databases, and select the previous workarea. * * Called by Event.prg ****************************************************************************** on error * && just in case BrowseWind isn't open close window BrowseWind on error use use in contact use in summary release isBrowseUp return .t. *** End of procedures and functions called by Contact.prg *** *** Procedures and Functions called by Event.prg *** ******************************************************************************* function MakeButtonWindow * Creates a window with a button that will move to new coordinates inside * the window when the left mouse button is clicked. * * Called by Event.prg ******************************************************************************* private o o = MakeWindow("Click anywhere to move button") && Make the window with one button o.OnLeftMouseDown=ButtonLeftMouseDown && Assign the function && ButtonLeftMouseDown to the event && OnLeftMouseDown. This is a && function pointer assignment. && The event gets the address of the && function to be executed. o.typewin = "Click anywhere to move button" return o ******************************************************************************* function MakeSizeWindow * Creates a window with a button. This window will get resized as you click * the left mouse button and move. * * Called by Event.prg ******************************************************************************* private o o = MakeWindow("Click anywhere to resize window") && create the window o.OnMouseMove=MouseMove && OnMouseMove event handler function o.OnLeftMouseDown=LeftMouseDown && OnLeftMouseDown event handler function o.typewin = "Click anywhere to resize window" return o ******************************************************************************* Function MakeWindow * Creates a window with one pushbutton * * Called by Event.prg ******************************************************************************* param captionStart private x,o,b set talk off w = "X"+str(c+1000,4) b = "B"+str(c+1000,4) * Create the window using DEFINE syntax define window &w from 1,1 to 50,50 title "Window" MDI sizeable define push &b of &w at 10,10 prompt "Button" acti window &w * get a handle to the defined window using the findwindow() function o = findwindow(w) o.ourname = w o.OnGotFocus=WinGotFocus && functions handling OnGotFocus and OnLostFocus o.OnLostFocus=WinLostFocus && events o.orgWidth = o.Width o.orgHeight = o.Height o.WindowNum = c o.bc = 1 o.capStart = captionStart c = c + 1 x= o.OnGotFocus() && The window has focus initially return o ******************************************************************************* function WinGotFocus * OnGotFocus event handler function for the window * * Called by Event.prg ******************************************************************************* private w this.caption = this.capStart + " -- Got Focus #" + str(this.WindowNum,1) w = this.ourname *acti window &w return .f. ******************************************************************************* procedure WinLostFocus * OnLostFocus event handler function for the window * * Called by Event.prg ******************************************************************************* this.caption = this.capStart + " -- Lost Focus #" + str(this.WindowNum,1) ******************************************************************************* function MouseMoveShow * * Called by Event.prg ******************************************************************************* parameters x, y, flags @ 0,0 ? x,y ******************************************************************************* procedure ButtonLeftMouseDown * OnLeftMouseDown event handler for the window created with MakeButtonWindow() * * Called by Event.prg ******************************************************************************* parameters x, y, flags private w,b,i,j,k if bits(flags,3) j = 0 k = 0 x = 0 y = 0 for i = 1 to this.bc if bits(flags,2) this[i].height = this[i].height * 2 this[i].width = this[i].width * 2 endif if j + this[i].height > this.height x = x + k j = 0 endif this[i].left = x this[i].top = j j = j + this[i].height if this[i].width > k k = this[i].width endif next else if bits(flags,2) this.bc = this.bc + 1 b = "B"+str(this.bc+1000,4) w = this.ourname define push &b of &w at 1000,1000 prompt "Button" endif this[this.bc].caption = ltrim(str(x))+","+ltrim(str(y)) this[this.bc].left = x this[this.bc].top = y endif ******************************************************************************* function MouseMove * Event handler for window created with MakeSizeWindow() * * Called by Event.prg ******************************************************************************* parameters x, y, flags if this.capture this.Width = x this.Height = y endif return .f. ******************************************************************************* procedure LeftMouseDown * Event handler for window created with MakeSizeWindow() * * Called by Event.prg ******************************************************************************* parameters x, y, flags if this.capture this.capture = .f. else this.capture = .t. x = this.OnMouseMove(x,y,flags) endif *** End of Procedures and Functions called by Event.prg *** *** Procedures and Functions called by WinApi *** ******************************************************************************* procedure OnSelApi * On selection routine for the Api window. Executes the function/group of * functions specified by the marked radiobutton. If "Cancel" was pressed, * the window is closed. * * Called by WinApi.prg ******************************************************************************* private selection selection = activecontrol() if selection = "CANCEL" set procedure to close window Api else if selection = "WINDIR" && function that returns a result ?WinDir() else do &selection && don't need to see the results of these endif endif ******************************************************************************** function SysInfo * Display information about the system. * * Called by WinApi.prg ******************************************************************************** setup() getinfo() showit() leave() ******************************************************************************** FUNCTION gVer * Gets information from the windows function * GetVersion(), which returns the major and minor * DOS and Windows versions as a CLONG. * * * The "High Byte of the High Word" contains the * major DOS version, the "Low Byte of the High Word" * contains the minor DOS version. The "High Byte of * the Low Word" specifies the minor version of * windows and the "Low byte of the Low Word" * specifies the major windows version. The Bit * functions are used to extract the proper values. * BitRshift(), BitAnd(). * * Called by WinApi.prg ******************************************************************************** PARAM verType #define HiWord(x) (bitrshift(bitand(x,4294901760),16)) #define LoWord(x) (bitand(x,65535)) #define HiByte(x) (ltrim(str(bitrshift(bitand(x,65280),8)))) #define LoByte(x) (ltrim(str(bitand(x,255)))) EXTERN PASCAL CLONG GetVersion( ) krnl386.exe z=GetVersion( ) IF UPPER(verType)="DOS" RETURN HiByte(HiWord(z))+"."+LoByte(HiWord(z)) ENDIF IF LEFT(UPPER(verType),3)="WIN" RETURN LoByte(LoWord(z))+"."+HiByte(LoWord(z)) ENDIF ******************************************************************************** FUNCTION setup * Called by Sysinfo(). This functions declares all the necessary * Windows API functions used for displaying system information, and defines * the window that will display that information. * * Called from file WinApi.prg ******************************************************************************** CLEAR SET TALK OFF Public mMode,mCpu,mCoprocess,mFreeMem,mInstance,wFreeMem,hndDBW hndDBW=_APP.FRAMEWIN.HWND EXTERN PASCAL CWORD GetWinFlags( ) krnl386.exe EXTERN PASCAL CWORD GetModuleUsage(CWORD) krnl386.exe EXTERN PASCAL CWORD GetModuleHandle(CPTR) krnl386.exe EXTERN PASCAL CWORD GetVersion( ) user.exe EXTERN PASCAL CWORD ShowWindow(CWORD,CWORD) user.exe DEFINE WINDOW sysinfo FROM 0,0 TO 19,40 TITLE "Windows System Information"; OF application SIZEABLE DEFINE PUSHBUTTON ok OF sysinfo PROMPT " OK " at 16,14 ON SELECTION WINDOW sysinfo DO leave RETURN 0 ******************************************************************************** FUNCTION getInfo * Called by Sysinfo(). This function makes the necessary API calls, and assigns * the accessed information to variables that will be displayed in the window * showing system information. * * Called from file WinApi.prg ******************************************************************************** mX1=GetModuleHandle("DBASEWIN.EXE") && "SYSINFO" mInstance=GetModuleUsage(mX1) x=GetWinFlags() mMode=IIF(x =BitOr(x,32),"Enhanced Mode",IIF(x=BitOr(x,16),"Standard Mode",; IIF(x=BitOr(x,2),"Running Win286",""))) mCpu=IIF(BitOr(x,8)=x,"80486",IIF(x=BitOr(x,4),"80386",IIF(x=BitOr(x,2),"80286",; IIF(x=BitOr(x,128),"80186",IIF(x=BitOr(x,64),"8086",""))))) mCoprocess=IIF(x=BitOr(x,1024),"Yes","No ") mFreeMem=LTRIM(STR(MEMO()))+"K" extern pascal clong GetFreeSpace( cword ) krnl386.exe wFreeMem=ltrim(str(GetFreeSpace(0)/1024))+"K" RETURN 0 ******************************************************************************** FUNCTION showIt * Called by Sysinfo(). This function brings up the window with system * information retrieved by calling Windows API functions through Bladerunner. * * Called from file WinApi.prg ******************************************************************************** CLEAR ? ShowWindow(hndDBW,7) && 7 make icon no acitve ACTIVATE WINDOW sysinfo @ 2,2 SAY "Number Of Instances "+LTRIM(STR(mInstance)) @ 4,2 SAY "Windows Version "+gVer("WIN") @ 6,2 SAY "Mode of Operation "+mMode @ 8,2 SAY "CPU Type "+mCpu @ 10,2 SAY "Coprocessor Present "+mCoprocess @ 12,2 SAY "Free Global Memory "+wFreeMem @ 14,2 SAY "Dos Version "+gVer("DOS") readmodal("sysinfo") RETURN 0 ******************************************************************************** FUNCTION leave * Called by Sysinfo(). Releases the window displaying system information. * * Called from file WinApi.prg ******************************************************************************** ? ShowWindow(hndDBW,4) && This works fine by it's self ACTIVATE SCREEN RELEASE WINDOW sysinfo RETURN 0 ******************************************************************************* procedure SysParm * Calls the Windows function SystemParametersInfo( ) for * seting up the windows desktop wallpaper. * Displays a getfile box to pick the wallpaper for * the windows desktop. * * Called by WinApi.prg ******************************************************************************* EXTERN PASCAL CWORD SystemParametersInfo(CWORD,CWORD,CPTR,CWORD) user.exe x=GETFILE("*.BMP","dBASE Wallpaper changer") DO WHILE LEN(x) > 0 SystemParametersInfo(20,0,x,2) x=GETFILE("*.BMP","dBASE Wallpaper changer") ENDDO ******************************************************************************* FUNCTION OkCanBox * OkCanBox(<cMess>,<cTitle>). * <cMess> = Message to display in Box. * <cTitle> = Title of Message Box. * * Creates a MessageBox on the SCREEN with * a title and message text. The user must * press or click OK or CANCEL or press ESCAPE * key. This is a System Modal MessageBox. * Calls the Windows function messagebox(). * choice = okcanbox("Read my lips","Message Box") * 2 if Escape pressed, 1 if OK button pressed, * 2 if CANCEL pressed. Or 0 if not enough memory. * * Called by WinApi.prg ******************************************************************************* * Returns 0 if not enough memory to create MessageBox. * Returns 1=OK,2=CANCEL,3=ABORT,4=RETRY,5=IGNORE,6=YES,7=NO,8=ONE * wType any combo of below * MODE DEFAULT BUTTON *0x3000h=12288D Mode Mask 0x0F00h=3840 Dec Def.Button *0x0000h=00000D App Modal 0x0000h=0000 Dec Button 1 *0x1000h=04096D Sys Modal 0x0100h=0256 Dec Button 2 *0x2000h=08192D Task Modal 0x0200h=0512 Dec Button 3 * 0x0300h=0768 Dec Button 4 * 0x0400h=1024 Dec Button 5 * 0x0500h=1280 Dec Button 6 * 0x0600h=1536 Dec Button 7 * 0x0700h=1792 Dec Button 8 * ICON BUTTON *0x00F0h=0240D Icon Mask 0x000Fh=0015Dec Type Mask *0x0010h=0016D Hand 0x0000h=0000Dec OK Button *0x0010h=0016D Stop * 0x0001h=0001Dec OK CANCEL *0x0020h=0032D Question 0x0002h=0002Dec ABORT RETRY IGNORE *0x0030h=0048D Exclaimation 0003h=0003Dec YES NO CANCEL *0x0040h=0064D Astrisk 0x0004h=0004Dec YES NO *0x0040h=0064D Information x0005h=0005Dec RETRY CANCEL * 0x0008h=0008Dec ABORT RETRY * 0x0009h=0009Dec OK CANCEL ABORT * RETRY IGNORE * 0x000Ah=0010Dec NO CANCEL RETRY * CANCEL GARBAGE * 0x000Bh=0011Dec OK CANCEL ABORT * RETRY IGNORE YES * NO CANCEL ******************************************************************************* PARAMETERS cMess, cTitle wType=HTOI("1031") && 1031h=4145decimal cMess1=IIF(ISBLANK(cMess),"Put Message Here! "+CHR(13)+CHR(13)+; "Syntax is: "+CHR(13)+"? OkcanBox('Message','Title')"+; CHR(13) + CHR(13) + "Returns: " + CHR(13) +; "1 if OK button clicked or pressed"+CHR(13)+; "2 if Cancel button or Escape key pressed"+CHR(13)+; "0 if not enough memory to run",cMess) cTitle1=IIF(ISBLANK(cTitle),"OkcanBox( ) Message Function",cTitle) extern pascal cword messagebox(cword,cptr,cptr,cword ) user.exe npressed=messagebox(0,cMess1,cTitle1,wType) RETURN npressed ******************************************************************************* procedure winwall * Calls the Windows WallPaper changer program. * First it reduces dBASE to an ICON then it * changes into the windows directory and displays a * GETFILE() box of the *.BMP files in the windows * directory then it changes the desktop wallpaper to * the file you choose.Next it asks if you want to keep * the Wallpaper or set it to (None) Then it returns to * the directory you started from and restores dBASE * from the ICON. * * * Called by WinApi.prg ******************************************************************************* EXTERN PASCAL CWORD SystemParametersInfo(CWORD,CWORD,CPTR,CWORD) user.exe EXTERN PASCAL CWORD CloseWindow(CWORD) user.exe EXTERN PASCAL CWORD OpenIcon(CWORD) user.exe hndDBW=_APP.FRAMEWIN.HWND CloseWindow(hndDBW) orgDir = SET("DIRECTORY") winPath = winDir() SET DIRECTORY TO &winPath x=GETFILE("*.BMP","dBASE Wallpaper changer") DO WHILE LEN(x) > 0 SystemParametersInfo(20,0,x,1) && WAS 2 x=GETFILE("*.BMP","dBASE Wallpaper changer") ENDDO blankWall = OkCanBox("Press OK to keep the Wallpaper"+; CHR(13)+"or press Cancel to set wallpaper to (None)",; "Keep the wallpaper or set to (None) ?") IF blankWall = 2 SystemParametersInfo(20,0,"(None)",2) ENDIF OpenIcon(hndDBW) SET DIRECTORY TO &orgDir ******************************************************************************* procedure GetWinTX * Calls the Windows function GetWindowText to get title of the * Bladerunner frame window * * Called by WinApi.prg ******************************************************************************* dBWhand = _APP.FRAMEWIN.HWND EXTERN PASCAL CWORD GetWindowText(CWORD,CPTR,CWORD) user.exe winTitle = SPACE(80) && first make empty string to be filled lenTitle = GetWindowText(dBWhand,winTitle,80) ? "The Title of dBASEWIN window from API call" ? winTitle ? * Note: The Object modle allows you to get this information with * the following command. ? _APP.FRAMEWIN.CAPTION ? "The Title of dBASEWIN window from the Object Model" ******************************************************************************* procedure Icon * This example just minimizes dBASEWIN.EXE to a * ICON (by way of the CloseWindow funtion) waits 5 * seconds then restores dBASEWIN.EXE from its ICON. * * Called by WinApi.prg ******************************************************************************* EXTERN PASCAL CWORD CloseWindow(CWORD) user.exe EXTERN PASCAL CWORD OpenIcon(CWORD) user.exe hwnd = _APP.FRAMEWIN.HWND && gets the window handle for dBASE. CloseWindow(hwnd) && reduce dBASE to an ICON INKEY(5) && wait 5 seconds OpenIcon(hwnd) && restore dBASE from an ICON ******************************************************************************* FUNCTION winDir * Calls the Windows Funnction GetWindowsDirectory( ) which * is used to get the Directory that windows is * installed in. * * Called by WinApi.prg ******************************************************************************* EXTERN PASCAL CWORD GetWindowsDirectory(CPTR,CWORD) krnl386.exe cWinDir = SPACE(144) cWinDirLen = GetWindowsDirectory(cWinDir,144) return cWinDir *** End of Procedures and Functions called by Winapi *** *** Procedures and Functions called by Puzzle.prg *** ************************************************* function MakePaint * * Called by Puzzle.prg ************************************************* parameters x, y, flags private p p = new PaintWindow() junk = p.Init() return .f. *--BUG: Functions have to appear at the end of the file (after class definitions) * ************************************************* function MakePuzzle * * Called by Puzzle.prg ************************************************* parameters x, y, flags private p p = new Puzzle() x = p.Show() return .f. ************************************************* function MakeDraw * * Called by Puzzle.prg ************************************************* parameters x, y, flags private p p = new DrawWindow() junk = p.Init() return .f. ************************************************* function RGB * Creates appropriate color number from the * passed red,green,blue color values * * Called by Puzzle.prg ************************************************* parameter r,g,b return b*65536+g*256+r ************************************************* function Rect * Creates a rectangle * * Called by Puzzle.prg ************************************************* parameter left, top, width, height return MakeInt(left)+MakeInt(top)+MakeInt(width+left)+MakeInt(top+height) ************************************************* function MakeInt * * Called by Puzzle.prg ************************************************* parameter int return chr(bitand(int,255))+chr(bitr(int,8)) ************************************************* function PushedButton * Toggles a color button's color being added to * the current painting color mixture. * * Called by Puzzle.prg ************************************************* parameters x, y, flags if isupper(this.caption) this.caption = lower(this.caption) this.colorval = 0 else this.caption = upper(this.caption) this.colorval = 255 endif junk = this.owner.SetButtonColor() return .f. *** End of Procedures and Functions called by Puzzle.prg *** *** Procedures and Functions called by OpenWind.prg *** ******************************************************************************* procedure ShowInfo * Brings up the Info window. This window contains text objects that correspond * to whatever information was selected for viewing in the previous, SelectInfo * window, and an image containing the map of Europe highlighting the currently * selected country. "Cancel" in this window closes it. * * Called by OpenWind.prg ******************************************************************************* private cnt,countryName,background,newArea windCnt = windCnt + 1 cnt = ltrim(str(windCnt)) countryName = rtrim(country->name)+cnt && in case the same country is chosen && more than once background = iif(mod(windCnt,2)=0,"b","bg") && alternate background window color newArea = ltrim(str(select())) if newArea <> "0" use country in select() again alias &countryName select &countryName * don't let the windows go off the screen define window Info&cnt from 2+mod(windCnt*2,20),30 + mod(windCnt,10); to 13+mod(windCnt*2,20),70+mod(windCnt,10) ; of application; title "Info -- " + country->name; sizeable; color w+/&background * show the population field for the current country define text popText of Info&cnt at 2,3 prompt "Population:" define text popInfo of Info&cnt at 3,5 prompt country->population; picture "999,999,999,999" function "T" color rb/&background * show the capital field for the current country define text capText of Info&cnt at 5,3 prompt "Capital:" define text capInfo of Info&cnt at 6,5 prompt upper(country->capital); color rb/&background * show the map of the current country highlighted on a map of Europe define text mapText of Info&cnt at 1,25 prompt country->name; color gr+/&background define image map of Info&cnt from 2,20 to 12,38 memo country->map define pushbutton cancel of Info&cnt at 8,5 prompt "CANCEL" default on selection window Info&cnt close window Info&cnt * OPEN this window, and set focus to it. This command causes Info to be * added to the list of the currently open windows, but doesn't stop program * control flow at the OPEN line. This window is not modal. open window Info&cnt set focus to Info&cnt else && no more available areas * Cheap warning ?"No more available workareas" endif return ******************************************************************************* function Clean_Openwindow * This function closes the Country database, and releases all public variables. * * Called by OpenWind.prg ******************************************************************************* use in country release windcnt return .t.